home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d10
/
sas.arc
/
FILES.CLA
< prev
next >
Wrap
Text File
|
1990-09-17
|
11KB
|
326 lines
FILES PROGRAM
REJECT_KEY EQUATE(CTRL_ESC)
ACCEPT_KEY EQUATE(CTRL_ENTER)
TRUE EQUATE(1)
FALSE EQUATE(0)
MAP
PROC(G_OPENFILES)
PROC(MAIN)
.
EJECT('FILE LAYOUTS')
CLIENTS FILE,PRE(CLI),CREATE,RECLAIM
CLIENT_KEY KEY(CLI:CLIENT),DUP,NOCASE,OPT
COMMENTS MEMO(490) !Comments
RECORD RECORD
CLIENT STRING(32) !Client Name
ORDEREDBY STRING(32) !Ordered By
ADD1 STRING(32) !Address #1
ADD2 STRING(32) !Address #2
CITY STRING(18) !City
STATE STRING(2) !State
ZIP DECIMAL(9,0) !Zip Code
DAYPHONE DECIMAL(10,0) !Day Phone
EXTENSION STRING(10) !Extension
EVEPHONE DECIMAL(10,0) !Eve Phone
FAXPHONE DECIMAL(10,0) !Fax Phone
. .
GROUP,OVER(CLI:COMMENTS)
CLI_MEMO_ROW STRING(70),DIM(7)
.
INVNTORY FILE,PRE(INV),CREATE,RECLAIM
PN_KEY KEY(INV:PARTNUM),NOCASE,OPT
COMMENTS MEMO(96) !Comments about Inventory Items
RECORD RECORD
PARTNUM STRING(16) !Part Number
PRODDESC STRING(30) !Product Description
COST REAL !Item Cost
MFGRETAIL REAL !MFG Retail Price
CLASS1 REAL !Price Class 1
CLASS2 REAL !Price Class 2
CLASS3 REAL !Price Class 3
TAXABLE STRING(3) !Taxable Flag
VENDOR STRING(32) !Vendor Name
. .
GROUP,OVER(INV:COMMENTS)
INV_MEMO_ROW STRING(32),DIM(3)
.
ORDERS FILE,PRE(ORD),CREATE,RECLAIM
ORDER_KEY KEY(ORD:ORDER_NUM),NOCASE,OPT
CLIENT_KEY KEY(ORD:CLIENT),DUP,NOCASE,OPT
TYPE_KEY KEY(ORD:TYPE),DUP,NOCASE,OPT
DATE_KEY KEY(ORD:DATE),DUP,NOCASE,OPT
NOTES MEMO(87) !Order Notes
RECORD RECORD
ORDER_NUM LONG !Order Number
CLIENT STRING(32) !Client Name
TYPE STRING(9) !Order Type
DATE LONG !Order Date
SALESPERSON STRING(32) !Salesperson
ORDERREF STRING(32) !Order Reference
PRICECLASS BYTE !Price Class
TAXPCT REAL !Tax Percentage
TAX REAL !Tax on Order
PAYMETHOD STRING(20) !Method of Payment
TERMS STRING(13) !Payment Terms
PO STRING(25) !Purchase Order Number
CCNUM STRING(25) !Credit Card Number
EXPDATE STRING(10) !Credit Card Expiration Date
SURCHARGE REAL !Credit Card Surcharge
SHIPTO STRING(32) !Ship To - Name
SHIPADD1 STRING(32) !Ship To - Address #1
SHIPADD2 STRING(32) !Ship To - Address #2
SHIPCITY STRING(18) !Ship To - City
SHIPSTATE STRING(2) !Ship To - State
SHIPZIP DECIMAL(9,0) !Ship To - Zip Code
SHIPATTN STRING(26) !Ship To - Attention
COST REAL !Order Cost
SUBTOTAL REAL !Order Subtotal
. .
GROUP,OVER(ORD:NOTES)
ORD_MEMO_ROW STRING(29),DIM(3)
.
ITEM_ORD FILE,PRE(ITE),CREATE
ORD_KEY KEY(ITE:ORDER_NUM),DUP,NOCASE,OPT
RECORD RECORD
ORDER_NUM LONG !Order Number
PART_NUM STRING(16) !Part Number
QTY SHORT !Quantity
DEFAULTPRICE REAL !Default Item Price
ORDERPRICE REAL !Order Price
. .
PAYMETHD FILE,PRE(PAY),CREATE,RECLAIM
METHOD_KEY KEY(PAY:METHOD_PAY),NOCASE,OPT
RECORD RECORD
METHOD_PAY STRING(20) !Method Of Payment
. .
TERMS FILE,PRE(TER),CREATE,RECLAIM
TERM_KEY KEY(TER:TERMS),NOCASE,OPT
RECORD RECORD
TERMS STRING(13) !Terms of Order
. .
VENDORS FILE,PRE(VEN),CREATE,RECLAIM
VEN_KEY KEY(VEN:VENDOR),DUP,NOCASE,OPT
COMMENTS MEMO(350) !Comments
RECORD RECORD
VENDOR STRING(32) !Vendor Name
ADD1 STRING(32) !Address #1
ADD2 STRING(32) !Address #2
CITY STRING(18) !City
STATE STRING(2) !State
ZIP DECIMAL(9,0) !Zip Code
CONTACT STRING(32) !Contact Person
DAYPHONE DECIMAL(10,0) !Phone Number
EXTENSION STRING(10) !Extension
EVEPHONE DECIMAL(10,0) !Phone Number #2
FAXPHONE DECIMAL(10,0) !Fax Phone Number
ACCTNUM STRING(20) !Account Number
TERMS STRING(32) !Terms
. .
GROUP,OVER(VEN:COMMENTS)
VEN_MEMO_ROW STRING(70),DIM(5)
.
COMPANY FILE,PRE(COM),RECLAIM
RECORD RECORD
COMPANY STRING(32)
ADD1 STRING(32)
ADD2 STRING(32)
CITY STRING(18)
STATE STRING(2)
ZIP DECIMAL(9,0)
PHONE DECIMAL(10,0)
TAXPCT REAL
COM1 STRING(60)
COM2 STRING(60)
COM3 STRING(60)
FIN3 DECIMAL(10,10)
FIN4 DECIMAL(10,10)
FIN5 DECIMAL(10,10)
C1MARGIN REAL !Class 1 Default Margin
C2MARGIN REAL !Class 2 Default Margin
C3MARGIN REAL !Class 3 Default MArgin
. .
EJECT('GLOBAL MEMORY VARIABLES')
ACTION SHORT !0 = NO ACTION
!1 = ADD RECORD
!2 = CHANGE RECORD
!3 = DELETE RECORD
!4 = LOOKUP FIELD
GROUP,PRE(MEM)
MESSAGE STRING(30) !Global Message Area
PAGE SHORT !Report Page Number
LINE SHORT !Report Line Number
DEVICE STRING(30) !Report Device Name
.
EJECT('CODE SECTION')
CODE
SETHUE(7,0) !SET WHITE ON BLACK
BLANK ! AND BLANK
G_OPENFILES !OPEN OR CREATE FILES
SETHUE() ! THE SCREEN
MAIN
RETURN !EXIT TO DOS
G_OPENFILES PROCEDURE !OPEN FILES & CHECK FOR ERROR
CODE
SHOW(25,1,CENTER('OPENING FILE: ' & 'CLIENTS',80)) !DISPLAY FILE NAME
OPEN(CLIENTS) !OPEN THE FILE
IF ERROR() !OPEN RETURNED AN ERROR
CASE ERRORCODE() ! CHECK FOR SPECIFIC ERROR
OF 46 ! KEYS NEED TO BE REQUILT
SETHUE(0,7) ! BLACK ON WHITE
SHOW(25,1,CENTER('REBUILDING KEY FILES FOR CLIENTS',80)) !INDICATE MSG
BUILD(CLIENTS) ! CALL THE BUILD PROCEDURE
SETHUE(7,0) ! WHITE ON BLACK
BLANK(25,1,1,80) ! BLANK THE MESSAGE
OF 2 !IF NOT FOUND,
CREATE(CLIENTS) ! CREATE
ELSE ! ANY OTHER ERROR
LOOP;STOP('CLIENTS: ' & ERROR()). ! STOP EXECUTION
. .
SHOW(25,1,CENTER('OPENING FILE: ' & 'INVNTORY',80)) !DISPLAY FILE NAME
OPEN(INVNTORY) !OPEN THE FILE
IF ERROR() !OPEN RETURNED AN ERROR
CASE ERRORCODE() ! CHECK FOR SPECIFIC ERROR
OF 46 ! KEYS NEED TO BE REQUILT
SETHUE(0,7) ! BLACK ON WHITE
SHOW(25,1,CENTER('REBUILDING KEY FILES FOR INVNTORY',80)) !INDICATE MSG
BUILD(INVNTORY) ! CALL THE BUILD PROCEDURE
SETHUE(7,0) ! WHITE ON BLACK
BLANK(25,1,1,80) ! BLANK THE MESSAGE
OF 2 !IF NOT FOUND,
CREATE(INVNTORY) ! CREATE
ELSE ! ANY OTHER ERROR
LOOP;STOP('INVNTORY: ' & ERROR()). ! STOP EXECUTION
. .
SHOW(25,1,CENTER('OPENING FILE: ' & 'ORDERS',80)) !DISPLAY FILE NAME
OPEN(ORDERS) !OPEN THE FILE
IF ERROR() !OPEN RETURNED AN ERROR
CASE ERRORCODE() ! CHECK FOR SPECIFIC ERROR
OF 46 ! KEYS NEED TO BE REQUILT
SETHUE(0,7) ! BLACK ON WHITE
SHOW(25,1,CENTER('REBUILDING KEY FILES FOR ORDERS',80)) !INDICATE MSG
BUILD(ORDERS) ! CALL THE BUILD PROCEDURE
SETHUE(7,0) ! WHITE ON BLACK
BLANK(25,1,1,80) ! BLANK THE MESSAGE
OF 2 !IF NOT FOUND,
CREATE(ORDERS) ! CREATE
ELSE ! ANY OTHER ERROR
LOOP;STOP('ORDERS: ' & ERROR()). ! STOP EXECUTION
. .
SHOW(25,1,CENTER('OPENING FILE: ' & 'ITEM_ORD',80)) !DISPLAY FILE NAME
OPEN(ITEM_ORD) !OPEN THE FILE
IF ERROR() !OPEN RETURNED AN ERROR
CASE ERRORCODE() ! CHECK FOR SPECIFIC ERROR
OF 46 ! KEYS NEED TO BE REQUILT
SETHUE(0,7) ! BLACK ON WHITE
SHOW(25,1,CENTER('REBUILDING KEY FILES FOR ITEM_ORD',80)) !INDICATE MSG
BUILD(ITEM_ORD) ! CALL THE BUILD PROCEDURE
SETHUE(7,0) ! WHITE ON BLACK
BLANK(25,1,1,80) ! BLANK THE MESSAGE
OF 2 !IF NOT FOUND,
CREATE(ITEM_ORD) ! CREATE
ELSE ! ANY OTHER ERROR
LOOP;STOP('ITEM_ORD: ' & ERROR()). ! STOP EXECUTION
. .
SHOW(25,1,CENTER('OPENING FILE: ' & 'PAYMETHD',80)) !DISPLAY FILE NAME
OPEN(PAYMETHD) !OPEN THE FILE
IF ERROR() !OPEN RETURNED AN ERROR
CASE ERRORCODE() ! CHECK FOR SPECIFIC ERROR
OF 46 ! KEYS NEED TO BE REQUILT
SETHUE(0,7) ! BLACK ON WHITE
SHOW(25,1,CENTER('REBUILDING KEY FILES FOR PAYMETHD',80)) !INDICATE MSG
BUILD(PAYMETHD) ! CALL THE BUILD PROCEDURE
SETHUE(7,0) ! WHITE ON BLACK
BLANK(25,1,1,80) ! BLANK THE MESSAGE
OF 2 !IF NOT FOUND,
CREATE(PAYMETHD) ! CREATE
ELSE ! ANY OTHER ERROR
LOOP;STOP('PAYMETHD: ' & ERROR()). ! STOP EXECUTION
. .
SHOW(25,1,CENTER('OPENING FILE: ' & 'TERMS',80)) !DISPLAY FILE NAME
OPEN(TERMS) !OPEN THE FILE
IF ERROR() !OPEN RETURNED AN ERROR
CASE ERRORCODE() ! CHECK FOR SPECIFIC ERROR
OF 46 ! KEYS NEED TO BE REQUILT
SETHUE(0,7) ! BLACK ON WHITE
SHOW(25,1,CENTER('REBUILDING KEY FILES FOR TERMS',80)) !INDICATE MSG
BUILD(TERMS) ! CALL THE BUILD PROCEDURE
SETHUE(7,0) ! WHITE ON BLACK
BLANK(25,1,1,80) ! BLANK THE MESSAGE
OF 2 !IF NOT FOUND,
CREATE(TERMS) ! CREATE
ELSE ! ANY OTHER ERROR
LOOP;STOP('TERMS: ' & ERROR()). ! STOP EXECUTION
. .
SHOW(25,1,CENTER('OPENING FILE: ' & 'VENDORS',80)) !DISPLAY FILE NAME
OPEN(VENDORS) !OPEN THE FILE
IF ERROR() !OPEN RETURNED AN ERROR
CASE ERRORCODE() ! CHECK FOR SPECIFIC ERROR
OF 46 ! KEYS NEED TO BE REQUILT
SETHUE(0,7) ! BLACK ON WHITE
SHOW(25,1,CENTER('REBUILDING KEY FILES FOR VENDORS',80)) !INDICATE MSG
BUILD(VENDORS) ! CALL THE BUILD PROCEDURE
SETHUE(7,0) ! WHITE ON BLACK
BLANK(25,1,1,80) ! BLANK THE MESSAGE
OF 2 !IF NOT FOUND,
CREATE(VENDORS) ! CREATE
ELSE ! ANY OTHER ERROR
LOOP;STOP('VENDORS: ' & ERROR()). ! STOP EXECUTION
. .
SHOW(25,1,CENTER('OPENING FILE: ' & 'COMPANY',80)) !DISPLAY FILE NAME
OPEN(COMPANY) !OPEN THE FILE
IF ERROR() !OPEN RETURNED AN ERROR
CASE ERRORCODE() ! CHECK FOR SPECIFIC ERROR
OF 46 ! KEYS NEED TO BE REQUILT
SETHUE(0,7) ! BLACK ON WHITE
SHOW(25,1,CENTER('REBUILDING KEY FILES FOR COMPANY',80)) !INDICATE MSG
BUILD(COMPANY) ! CALL THE BUILD PROCEDURE
SETHUE(7,0) ! WHITE ON BLACK
BLANK(25,1,1,80) ! BLANK THE MESSAGE
ELSE ! ANY OTHER ERROR
LOOP;STOP('COMPANY: ' & ERROR()). ! STOP EXECUTION
. .
BLANK !BLANK THE SCREEN
MAIN PROCEDURE
CODE
STREAM(ORDERS)
SET(ORDERS)
LOOP UNTIL EOF(ORDERS)
NEXT(ORDERS)
ORD:TAX=(ORD:TAXPCT/100)*ORD:SUBTOTAL
PUT(ORDERS)
.
STREAM(INVNTORY)
SET(INVNTORY)
LOOP UNTIL EOF(INVNTORY)
NEXT(INVNTORY)
INV:TAXABLE='YES'
INV:CLASS3=INV:CLASS2
PUT(INVNTORY)
.
RETURN